Author

510459602

Published

October 16, 2022

1 Data Tidying

Code
library(tidyverse)
library(dplyr)

data <- read.delim("bodyfat.txt")

# arrange data in ascending order 
data_order <- data %>% 
 arrange(Pct.BF) 

# override weight and height columns in pounds and inches to kilograms and meters, categorise ages, create BMI variable
data1 <- data_order %>% 
  mutate(Height = (Height/39.37)) %>%
  mutate(Weight = (Weight/2.205)) %>%
  mutate(BMI = (Weight/(Height)^2))

# only keep percentage body fat values greater than 3% (remove two points)
df <- subset(data1, Pct.BF>=3)

# remove density
df <- df[ , !names(df) %in% c("Density")] ## works as expected

1.1 Pairs Plot

Code
suppressWarnings({ 
  panel.cor <- function(x, y){
    usr <- par("usr"); on.exit(par(usr))
    par(usr = c(0, 1, 0, 1))
    r <- round(cor(x, y), digits=2)
    txt <- paste0("R = ", r)
    text(0.5, 0.5, txt)}

upper.panel <- function(x, y){
  points(x,y)}


pairs(df[,c(1:4, 7:9, 16)], 
      lower.panel = panel.cor,
      upper.panel = upper.panel)
})

2 Models

Unless the number of candidate variables > sample size (or number of events), use a backward stepwise approach (https://quantifyinghealth.com/stepwise-selection/)

Josh mentioned his group used weight and BMI (indirectly includes height)?? - neither model output includes either variable

2.1 Backward stepwise selection

Code
# intercept-only model
intercept_only <- lm(Pct.BF ~ 1, data = df)

# model with all predictors
model <- lm(Pct.BF ~ ., data = df) #Added intercept back in

# backward stepwise regression
backward <- step(model, direction = 'backward', scope = formula(model), trace = TRUE)
Start:  AIC=728.05
Pct.BF ~ Age + Weight + Height + Neck + Chest + Abdomen + Waist + 
    Hip + Thigh + Knee + Ankle + Bicep + Forearm + Wrist + BMI


Step:  AIC=728.05
Pct.BF ~ Age + Weight + Height + Neck + Chest + Abdomen + Hip + 
    Thigh + Knee + Ankle + Bicep + Forearm + Wrist + BMI

          Df Sum of Sq    RSS    AIC
- Knee     1      0.30 4139.0 726.06
- Ankle    1      7.41 4146.1 726.49
- Bicep    1     17.32 4156.0 727.08
- Thigh    1     19.96 4158.6 727.24
- Forearm  1     21.64 4160.3 727.34
- Height   1     32.42 4171.1 727.98
<none>                 4138.7 728.05
- Chest    1     34.66 4173.3 728.11
- Hip      1     38.70 4177.4 728.35
- Neck     1     48.26 4186.9 728.92
- Weight   1     49.00 4187.7 728.96
- BMI      1     55.30 4194.0 729.34
- Age      1     87.44 4226.1 731.23
- Wrist    1    217.15 4355.8 738.73
- Abdomen  1   1585.19 5723.9 806.46

Step:  AIC=726.06
Pct.BF ~ Age + Weight + Height + Neck + Chest + Abdomen + Hip + 
    Thigh + Ankle + Bicep + Forearm + Wrist + BMI

          Df Sum of Sq    RSS    AIC
- Ankle    1      8.31 4147.3 724.56
- Bicep    1     17.14 4156.1 725.09
- Forearm  1     22.08 4161.1 725.38
- Thigh    1     23.02 4162.0 725.44
- Height   1     32.11 4171.1 725.98
<none>                 4139.0 726.06
- Chest    1     34.86 4173.8 726.14
- Hip      1     38.40 4177.4 726.35
- Weight   1     49.24 4188.2 727.00
- Neck     1     49.46 4188.4 727.01
- BMI      1     55.26 4194.2 727.35
- Age      1     95.36 4234.3 729.71
- Wrist    1    217.13 4356.1 736.74
- Abdomen  1   1585.57 5724.5 804.49

Step:  AIC=724.56
Pct.BF ~ Age + Weight + Height + Neck + Chest + Abdomen + Hip + 
    Thigh + Bicep + Forearm + Wrist + BMI

          Df Sum of Sq    RSS    AIC
- Bicep    1     16.06 4163.3 723.52
- Forearm  1     21.69 4169.0 723.86
- Thigh    1     24.03 4171.3 723.99
<none>                 4147.3 724.56
- Height   1     34.23 4181.5 724.60
- Chest    1     37.51 4184.8 724.79
- Hip      1     41.13 4188.4 725.01
- Weight   1     48.45 4195.7 725.44
- Neck     1     56.35 4203.6 725.91
- BMI      1     59.02 4206.3 726.07
- Age      1     92.81 4240.1 728.05
- Wrist    1    209.41 4356.7 734.78
- Abdomen  1   1581.58 5728.9 802.68

Step:  AIC=723.52
Pct.BF ~ Age + Weight + Height + Neck + Chest + Abdomen + Hip + 
    Thigh + Forearm + Wrist + BMI

          Df Sum of Sq    RSS    AIC
- Height   1     31.36 4194.7 723.38
<none>                 4163.3 723.52
- Chest    1     34.64 4198.0 723.57
- Thigh    1     35.41 4198.8 723.62
- Forearm  1     36.39 4199.7 723.68
- Weight   1     43.18 4206.5 724.08
- Hip      1     45.12 4208.5 724.19
- Neck     1     52.39 4215.7 724.62
- BMI      1     56.91 4220.3 724.89
- Age      1     97.04 4260.4 727.23
- Wrist    1    206.56 4369.9 733.53
- Abdomen  1   1567.70 5731.0 800.78

Step:  AIC=723.38
Pct.BF ~ Age + Weight + Neck + Chest + Abdomen + Hip + Thigh + 
    Forearm + Wrist + BMI

          Df Sum of Sq    RSS    AIC
- Weight   1     17.23 4211.9 722.40
- Thigh    1     24.86 4219.6 722.85
- Chest    1     31.85 4226.6 723.26
- Hip      1     32.25 4227.0 723.28
<none>                 4194.7 723.38
- Forearm  1     39.93 4234.6 723.73
- Neck     1     54.63 4249.3 724.59
- BMI      1     81.77 4276.5 726.17
- Age      1     84.49 4279.2 726.33
- Wrist    1    197.75 4392.5 732.81
- Abdomen  1   1616.25 5811.0 802.21

Step:  AIC=722.4
Pct.BF ~ Age + Neck + Chest + Abdomen + Hip + Thigh + Forearm + 
    Wrist + BMI

          Df Sum of Sq    RSS    AIC
- Thigh    1     17.99 4229.9 721.45
- Forearm  1     32.29 4244.2 722.29
<none>                 4211.9 722.40
- Chest    1     74.34 4286.3 724.74
- Neck     1     74.89 4286.8 724.77
- Hip      1     82.26 4294.2 725.19
- BMI      1    113.47 4325.4 726.99
- Age      1    113.99 4325.9 727.02
- Wrist    1    275.20 4487.1 736.09
- Abdomen  1   1621.24 5833.2 801.16

Step:  AIC=721.45
Pct.BF ~ Age + Neck + Chest + Abdomen + Hip + Forearm + Wrist + 
    BMI

          Df Sum of Sq    RSS    AIC
<none>                 4229.9 721.45
- Forearm  1     36.20 4266.1 721.57
- Hip      1     64.45 4294.4 723.21
- Neck     1     65.98 4295.9 723.29
- Chest    1     92.13 4322.1 724.80
- Age      1     96.25 4326.2 725.04
- BMI      1    143.54 4373.5 727.73
- Wrist    1    274.65 4504.6 735.06
- Abdomen  1   1641.41 5871.3 800.77
Code
# results 
backward$anova
Code
# final model
backward$coefficients
(Intercept)         Age        Neck       Chest     Abdomen         Hip 
 5.41445243  0.06477303 -0.42294001 -0.21543347  0.84388445 -0.20411692 
    Forearm       Wrist         BMI 
 0.27665906 -1.87789883  0.68200018 
Code
summary(backward) #Added summary to examine P values

Call:
lm(formula = Pct.BF ~ Age + Neck + Chest + Abdomen + Hip + Forearm + 
    Wrist + BMI, data = df)

Residuals:
     Min       1Q   Median       3Q      Max 
-10.6033  -3.0077  -0.3505   3.0470   9.8132 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept)  5.41445    7.48055   0.724 0.469894    
Age          0.06477    0.02777   2.332 0.020529 *  
Neck        -0.42294    0.21904  -1.931 0.054683 .  
Chest       -0.21543    0.09442  -2.282 0.023392 *  
Abdomen      0.84388    0.08763   9.630  < 2e-16 ***
Hip         -0.20412    0.10696  -1.908 0.057548 .  
Forearm      0.27666    0.19346   1.430 0.153997    
Wrist       -1.87790    0.47671  -3.939 0.000107 ***
BMI          0.68200    0.23948   2.848 0.004785 ** 
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 4.207 on 239 degrees of freedom
Multiple R-squared:  0.7425,    Adjusted R-squared:  0.7338 
F-statistic: 86.13 on 8 and 239 DF,  p-value: < 2.2e-16

Model:

pct.bf ~

2.2 Backward stepwise selection (plot method/same result)

Code
library(olsrr)

model <- lm(Pct.BF ~ ., data = df)

ols_step_backward_aic(model)

                      Backward Elimination Summary                       
-----------------------------------------------------------------------
Variable        AIC         RSS        Sum Sq       R-Sq      Adj. R-Sq 
-----------------------------------------------------------------------
Full Model    1435.839    4138.670    12286.272    0.74803      0.73289 
Abdomen       1433.839    4138.670    12286.272    0.74803      0.73289 
Knee          1431.858    4138.973    12285.969    0.74801      0.73401 
Ankle         1430.355    4147.288    12277.654    0.74750      0.73461 
Bicep         1429.314    4163.347    12261.594    0.74652      0.73471 
Height        1429.175    4194.712    12230.230    0.74461      0.73384 
Weight        1428.191    4211.938    12213.004    0.74356      0.73387 
Thigh         1427.248    4229.930    12195.012    0.74247      0.73385 
-----------------------------------------------------------------------
Code
a <- ols_step_backward_aic(model)

# stepwise backward regression plot
plot(a)

Code
# final model 
a$model

Call:
lm(formula = paste(response, "~", paste(preds, collapse = " + ")), 
    data = l)

Coefficients:
(Intercept)          Age         Neck        Chest        Waist          Hip  
    5.41445      0.06477     -0.42294     -0.21543      2.14347     -0.20412  
    Forearm        Wrist          BMI  
    0.27666     -1.87790      0.68200  

Model:

pct.bf ~ 449.55 - 415.14*density + 0.01500*age + 0.04816*chest + 0.04140*hip - 0.05793*bicep

2.3 Forward stepwise selection

Code
# intercept-only model
intercept_only <- lm(Pct.BF ~ 1, data = df)

# model with all predictors
model <- lm(Pct.BF ~ ., data = df)

# forward stepwise regression
forward <- step(intercept_only, direction = 'forward', scope = formula(model), trace = TRUE)
Start:  AIC=1041.9
Pct.BF ~ 1

          Df Sum of Sq     RSS     AIC
+ Waist    1   10978.9  5446.1  770.13
+ Abdomen  1   10978.9  5446.1  770.13
+ BMI      1    8926.9  7498.1  849.42
+ Chest    1    7850.8  8574.1  882.68
+ Hip      1    6304.7 10120.2  923.80
+ Weight   1    5959.9 10465.0  932.11
+ Thigh    1    4614.9 11810.0  962.09
+ Knee     1    3697.6 12727.3  980.64
+ Neck     1    3658.9 12766.1  981.40
+ Bicep    1    3509.2 12915.7  984.29
+ Forearm  1    1956.4 14468.6 1012.44
+ Wrist    1    1669.2 14755.7 1017.32
+ Age      1    1390.4 15034.5 1021.96
+ Ankle    1     860.4 15564.5 1030.55
<none>                 16424.9 1041.90
+ Height   1      50.8 16374.2 1043.13

Step:  AIC=770.13
Pct.BF ~ Waist

          Df Sum of Sq    RSS    AIC
+ Weight   1    792.60 4653.5 733.12
+ Wrist    1    686.47 4759.6 738.71
+ Height   1    641.91 4804.1 741.02
+ Neck     1    471.29 4974.8 749.68
+ Hip      1    395.63 5050.4 753.42
+ Knee     1    315.75 5130.3 757.31
+ Chest    1    241.27 5204.8 760.89
+ Ankle    1    176.39 5269.7 763.96
+ Age      1    161.40 5284.7 764.67
+ Thigh    1    146.35 5299.7 765.37
+ Forearm  1    134.96 5311.1 765.90
+ Bicep    1    125.08 5321.0 766.36
<none>                 5446.1 770.13
+ BMI      1      6.20 5439.8 771.84

Step:  AIC=733.12
Pct.BF ~ Waist + Weight

          Df Sum of Sq    RSS    AIC
+ Wrist    1   189.173 4464.3 724.83
+ Neck     1    68.842 4584.6 731.42
+ BMI      1    60.627 4592.8 731.87
+ Thigh    1    53.704 4599.8 732.24
+ Height   1    48.709 4604.7 732.51
+ Bicep    1    37.463 4616.0 733.12
<none>                 4653.5 733.12
+ Forearm  1    15.801 4637.7 734.28
+ Chest    1     5.217 4648.2 734.84
+ Ankle    1     1.292 4652.2 735.05
+ Age      1     1.254 4652.2 735.05
+ Hip      1     0.907 4652.6 735.07
+ Knee     1     0.362 4653.1 735.10

Step:  AIC=724.83
Pct.BF ~ Waist + Weight + Wrist

          Df Sum of Sq    RSS    AIC
+ BMI      1    65.580 4398.7 723.16
+ Bicep    1    55.921 4408.4 723.70
+ Height   1    52.909 4411.4 723.87
+ Forearm  1    45.022 4419.3 724.31
<none>                 4464.3 724.83
+ Age      1    32.742 4431.5 725.00
+ Thigh    1    20.301 4444.0 725.70
+ Ankle    1    16.210 4448.1 725.93
+ Neck     1    12.324 4452.0 726.14
+ Knee     1     4.595 4459.7 726.57
+ Hip      1     2.613 4461.7 726.68
+ Chest    1     2.116 4462.2 726.71

Step:  AIC=723.16
Pct.BF ~ Waist + Weight + Wrist + BMI

          Df Sum of Sq    RSS    AIC
+ Age      1    45.541 4353.2 722.58
<none>                 4398.7 723.16
+ Bicep    1    29.400 4369.3 723.49
+ Forearm  1    25.192 4373.5 723.73
+ Neck     1    24.496 4374.2 723.77
+ Chest    1    23.001 4375.7 723.86
+ Ankle    1    14.099 4384.6 724.36
+ Knee     1    12.876 4385.8 724.43
+ Height   1    11.085 4387.6 724.53
+ Hip      1     9.432 4389.3 724.63
+ Thigh    1     5.451 4393.3 724.85

Step:  AIC=722.58
Pct.BF ~ Waist + Weight + Wrist + BMI + Age

          Df Sum of Sq    RSS    AIC
+ Chest    1    43.024 4310.1 722.11
<none>                 4353.2 722.58
+ Bicep    1    31.027 4322.1 722.80
+ Neck     1    30.902 4322.3 722.81
+ Forearm  1    30.869 4322.3 722.81
+ Thigh    1    28.113 4325.0 722.97
+ Ankle    1    18.910 4334.3 723.50
+ Height   1    16.719 4336.4 723.62
+ Knee     1     9.745 4343.4 724.02
+ Hip      1     2.129 4351.0 724.46

Step:  AIC=722.11
Pct.BF ~ Waist + Weight + Wrist + BMI + Age + Chest

          Df Sum of Sq    RSS    AIC
<none>                 4310.1 722.11
+ Forearm  1    33.048 4277.1 722.20
+ Bicep    1    32.101 4278.0 722.26
+ Neck     1    25.117 4285.0 722.66
+ Height   1    19.286 4290.9 723.00
+ Ankle    1    14.895 4295.2 723.26
+ Hip      1    13.187 4297.0 723.35
+ Thigh    1    10.612 4299.5 723.50
+ Knee     1     3.724 4306.4 723.90
Code
forward <- step(intercept_only, direction = 'forward', scope = formula(model), trace = 0)

# results 
forward$anova
Code
# final model
forward$coefficients
 (Intercept)        Waist       Weight        Wrist          BMI          Age 
-14.29367064   2.08058656  -0.13548606  -1.80457263   0.58766228   0.05560285 
       Chest 
 -0.15643720 

Model:

pct.bf ~ 445.22 - 409.17*density + 0.057464*abdomen + 0.011260*age

Code
# if cannot implement, install.package('ggfortify')
library(ggfortify)
# determine log(k) k Value
nrow(df)
[1] 248
Code
M1 <- lm(Pct.BF ~ ., data = df) 

# Doing BIC
M1.step <- step(M1, 
                scope = list(lower = df ~ 1, 
                             upper = df ~ .),
               direction = "backward", k = log(248))
Start:  AIC=780.75
Pct.BF ~ Age + Weight + Height + Neck + Chest + Abdomen + Waist + 
    Hip + Thigh + Knee + Ankle + Bicep + Forearm + Wrist + BMI


Step:  AIC=780.75
Pct.BF ~ Age + Weight + Height + Neck + Chest + Abdomen + Hip + 
    Thigh + Knee + Ankle + Bicep + Forearm + Wrist + BMI

          Df Sum of Sq    RSS    AIC
- Knee     1      0.30 4139.0 775.25
- Ankle    1      7.41 4146.1 775.68
- Bicep    1     17.32 4156.0 776.27
- Thigh    1     19.96 4158.6 776.43
- Forearm  1     21.64 4160.3 776.53
- Height   1     32.42 4171.1 777.17
- Chest    1     34.66 4173.3 777.30
- Hip      1     38.70 4177.4 777.54
- Neck     1     48.26 4186.9 778.11
- Weight   1     49.00 4187.7 778.15
- BMI      1     55.30 4194.0 778.53
- Age      1     87.44 4226.1 780.42
<none>                 4138.7 780.75
- Wrist    1    217.15 4355.8 787.92
- Abdomen  1   1585.19 5723.9 855.65

Step:  AIC=775.25
Pct.BF ~ Age + Weight + Height + Neck + Chest + Abdomen + Hip + 
    Thigh + Ankle + Bicep + Forearm + Wrist + BMI

          Df Sum of Sq    RSS    AIC
- Ankle    1      8.31 4147.3 770.24
- Bicep    1     17.14 4156.1 770.76
- Forearm  1     22.08 4161.1 771.06
- Thigh    1     23.02 4162.0 771.11
- Height   1     32.11 4171.1 771.66
- Chest    1     34.86 4173.8 771.82
- Hip      1     38.40 4177.4 772.03
- Weight   1     49.24 4188.2 772.67
- Neck     1     49.46 4188.4 772.68
- BMI      1     55.26 4194.2 773.03
<none>                 4139.0 775.25
- Age      1     95.36 4234.3 775.39
- Wrist    1    217.13 4356.1 782.42
- Abdomen  1   1585.57 5724.5 850.17

Step:  AIC=770.24
Pct.BF ~ Age + Weight + Height + Neck + Chest + Abdomen + Hip + 
    Thigh + Bicep + Forearm + Wrist + BMI

          Df Sum of Sq    RSS    AIC
- Bicep    1     16.06 4163.3 765.68
- Forearm  1     21.69 4169.0 766.02
- Thigh    1     24.03 4171.3 766.16
- Height   1     34.23 4181.5 766.76
- Chest    1     37.51 4184.8 766.96
- Hip      1     41.13 4188.4 767.17
- Weight   1     48.45 4195.7 767.60
- Neck     1     56.35 4203.6 768.07
- BMI      1     59.02 4206.3 768.23
- Age      1     92.81 4240.1 770.21
<none>                 4147.3 770.24
- Wrist    1    209.41 4356.7 776.94
- Abdomen  1   1581.58 5728.9 844.84

Step:  AIC=765.68
Pct.BF ~ Age + Weight + Height + Neck + Chest + Abdomen + Hip + 
    Thigh + Forearm + Wrist + BMI

          Df Sum of Sq    RSS    AIC
- Height   1     31.36 4194.7 762.03
- Chest    1     34.64 4198.0 762.22
- Thigh    1     35.41 4198.8 762.27
- Forearm  1     36.39 4199.7 762.33
- Weight   1     43.18 4206.5 762.73
- Hip      1     45.12 4208.5 762.84
- Neck     1     52.39 4215.7 763.27
- BMI      1     56.91 4220.3 763.53
<none>                 4163.3 765.68
- Age      1     97.04 4260.4 765.88
- Wrist    1    206.56 4369.9 772.18
- Abdomen  1   1567.70 5731.0 839.42

Step:  AIC=762.03
Pct.BF ~ Age + Weight + Neck + Chest + Abdomen + Hip + Thigh + 
    Forearm + Wrist + BMI

          Df Sum of Sq    RSS    AIC
- Weight   1     17.23 4211.9 757.53
- Thigh    1     24.86 4219.6 757.98
- Chest    1     31.85 4226.6 758.39
- Hip      1     32.25 4227.0 758.42
- Forearm  1     39.93 4234.6 758.87
- Neck     1     54.63 4249.3 759.72
- BMI      1     81.77 4276.5 761.30
- Age      1     84.49 4279.2 761.46
<none>                 4194.7 762.03
- Wrist    1    197.75 4392.5 767.94
- Abdomen  1   1616.25 5811.0 837.34

Step:  AIC=757.53
Pct.BF ~ Age + Neck + Chest + Abdomen + Hip + Thigh + Forearm + 
    Wrist + BMI

          Df Sum of Sq    RSS    AIC
- Thigh    1     17.99 4229.9 753.08
- Forearm  1     32.29 4244.2 753.91
- Chest    1     74.34 4286.3 756.36
- Neck     1     74.89 4286.8 756.39
- Hip      1     82.26 4294.2 756.82
<none>                 4211.9 757.53
- BMI      1    113.47 4325.4 758.61
- Age      1    113.99 4325.9 758.64
- Wrist    1    275.20 4487.1 767.71
- Abdomen  1   1621.24 5833.2 832.78

Step:  AIC=753.08
Pct.BF ~ Age + Neck + Chest + Abdomen + Hip + Forearm + Wrist + 
    BMI

          Df Sum of Sq    RSS    AIC
- Forearm  1     36.20 4266.1 749.68
- Hip      1     64.45 4294.4 751.31
- Neck     1     65.98 4295.9 751.40
- Chest    1     92.13 4322.1 752.91
<none>                 4229.9 753.08
- Age      1     96.25 4326.2 753.14
- BMI      1    143.54 4373.5 755.84
- Wrist    1    274.65 4504.6 763.16
- Abdomen  1   1641.41 5871.3 828.88

Step:  AIC=749.68
Pct.BF ~ Age + Neck + Chest + Abdomen + Hip + Wrist + BMI

          Df Sum of Sq    RSS    AIC
- Neck     1     47.44 4313.6 746.90
- Hip      1     59.91 4326.0 747.62
- Age      1     78.29 4344.4 748.67
- Chest    1     83.56 4349.7 748.97
<none>                 4266.1 749.68
- BMI      1    167.89 4434.0 753.73
- Wrist    1    244.17 4510.3 757.97
- Abdomen  1   1606.00 5872.1 823.40

Step:  AIC=746.9
Pct.BF ~ Age + Chest + Abdomen + Hip + Wrist + BMI

          Df Sum of Sq    RSS    AIC
- Hip      1     57.10 4370.7 744.65
- Age      1     91.86 4405.4 746.62
<none>                 4313.6 746.90
- Chest    1    112.38 4426.0 747.77
- BMI      1    148.42 4462.0 749.78
- Wrist    1    455.13 4768.7 766.27
- Abdomen  1   1585.46 5899.0 819.02

Step:  AIC=744.65
Pct.BF ~ Age + Chest + Abdomen + Wrist + BMI

          Df Sum of Sq    RSS    AIC
<none>                 4370.7 744.65
- Chest    1    108.17 4478.8 745.20
- BMI      1    118.10 4488.8 745.75
- Age      1    270.47 4641.1 754.03
- Wrist    1    637.60 5008.3 772.91
- Abdomen  1   1713.22 6083.9 821.16
Code
# sumary of bic
summary(M1.step)

Call:
lm(formula = Pct.BF ~ Age + Chest + Abdomen + Wrist + BMI, data = df)

Residuals:
     Min       1Q   Median       3Q      Max 
-10.4758  -3.0762  -0.3885   3.3590   9.3983 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept) -3.36980    6.13790  -0.549  0.58350    
Age          0.08868    0.02292   3.870  0.00014 ***
Chest       -0.22855    0.09339  -2.447  0.01511 *  
Abdomen      0.74584    0.07658   9.740  < 2e-16 ***
Wrist       -2.32645    0.39155  -5.942 9.77e-09 ***
BMI          0.59467    0.23256   2.557  0.01117 *  
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 4.25 on 242 degrees of freedom
Multiple R-squared:  0.7339,    Adjusted R-squared:  0.7284 
F-statistic: 133.5 on 5 and 242 DF,  p-value: < 2.2e-16
Code
# graph of bic
autoplot(M1.step)

3 Performance

Code
# Forward AIC model
# PCT.bf ~  Waist + Weight + Wrist + BMI + Age + Chest
forward_value = round(summary(forward)$r.squared,3) 

# Backward AIC model
# PCT.bf ~ Age + Neck + Chest + Abdomen + Hip + Forearm + Wrist + BMI
backward_value = round(summary(backward)$r.squared,3)

3.1 In sample

The forward AIC model has an R-squared value of 0.738 while the backward model has an value of 0.742. It seems that backward AIC models fits the dataset a little better.

Code
sjPlot::tab_model(forward,backward,show.ci = FALSE,dv.labels = c("Forward model", "Backward model"))
  Forward model Backward model
Predictors Estimates p Estimates p
(Intercept) -14.29 0.095 5.41 0.470
Waist 2.08 <0.001
Weight -0.14 0.067
Wrist -1.80 <0.001 -1.88 <0.001
BMI 0.59 0.012 0.68 0.005
Age 0.06 0.057 0.06 0.021
Chest -0.16 0.122 -0.22 0.023
Neck -0.42 0.055
Abdomen 0.84 <0.001
Hip -0.20 0.058
Forearm 0.28 0.154
Observations 248 248
R2 / R2 adjusted 0.738 / 0.731 0.742 / 0.734

3.2 Out of sample

We use 10 fold cross validation here over 5 fold since there are 248 observations in the dataset and we allow more observations to train the model. Using 10 fold cross validation, the backward AIC model has slight advantage over forward AIC as shown below.

Code
library(caret)
set.seed(1)

# 10 fold cross validation
ten_fold = trainControl(
    method = "cv", number = 10,
    verboseIter = FALSE
  )

# forward model
cv_forward = train(
  Pct.BF ~  Waist + Weight + Wrist + BMI + Age + Chest, df,
  method = "lm",
  trControl = ten_fold
)

cv_backward = train(
  Pct.BF ~ Age + Neck + Chest + Abdomen + Hip + Forearm + Wrist + BMI, df,
  method = "lm",
  trControl = ten_fold
)
Method = c("forward AIC","backward AIC")
RMSE = c(cv_forward$results$RMSE,cv_backward$results$RMSE)
MAE  = c(cv_forward$results$MAE,cv_backward$results$MAE)
knitr::kable(data.frame(Method, RMSE,MAE))
Method RMSE MAE
forward AIC 4.248829 3.543263
backward AIC 4.191074 3.452402
Code
set.seed(1)
results <- resamples(list(Forward_AIC = cv_forward, Backward_AIC = cv_backward))

# put into a dataframe
mae = c(results$values$`Forward_AIC~MAE`,results$values$`Backward_AIC~MAE`)
rmse = c(results$values$`Forward_AIC~RMSE`,results$values$`Backward_AIC~RMSE`)
combine = data.frame(mae,rmse)
combine = combine%>% mutate(type = c(rep("Forward_AIC",10),rep("Backward_AIC",10)))
colnames(combine) <- c('MAE','RMSE','type')

# draw the plot
p1 = plotly::ggplotly(ggplot(combine,aes(x = type,y=MAE,color=type)) +geom_boxplot()+
  labs(y = "MAE")+theme_light()+theme(axis.title.y = element_blank())+coord_flip())

p2 = plotly::ggplotly(ggplot(combine,aes(x = type,y=RMSE,color=type)) +geom_boxplot()+
  labs(y = "RMSE")+theme_light()+theme(axis.title.y = element_blank())+coord_flip())

manipulateWidget::combineWidgets(p1, p2, nrow = 2)
Code
# # 10 fold cross validation
# ten_fold = trainControl(
#     method = "cv", number = 5,
#     verboseIter = FALSE
#   )
# 
# # forward model
# cv_forward_five = train(
#   Pct.BF ~  Waist + Weight + Wrist + BMI + Age + Chest, df,
#   method = "lm",
#   trControl = ten_fold
# )
# 
# cv_backward_five = train(
#   Pct.BF ~ Age + Neck + Chest + Abdomen + Hip + Forearm + Wrist + BMI, df,
#   method = "lm",
#   trControl = ten_fold
# )
# Method = c("forward AIC","backward AIC")
# RMSE = c(cv_forward_five$results$RMSE,cv_backward_five$results$RMSE)
# MAE  = c(cv_forward_five$results$MAE,cv_backward_five$results$MAE)
# knitr::kable(data.frame(Method, RMSE,MAE))